/*
 * Copyright (C) 2008-2012  Paulo Cesar Pereira de Andrade.
 *
 * This is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * Authors:
 *	Paulo Cesar Pereira de Andrade
 */

#include "exl.h"

/*
 * Defines
 */
#define mark_p(memory)		((eword_t)(memory)->next & 1)
#define mark(memory)							\
    (memory)->next = (memory_t *)((eword_t)(memory)->next | 1)
#define clear(memory)							\
    (memory)->next = (memory_t *)((eword_t)(memory)->next & ~1)
#define memory_to_object(type, memory)					\
    (type)((eint8_t *)(memory) + sizeof(memory_t))
#define object_to_memory(object)					\
    (memory_t *)((eint8_t *)(object) - sizeof(memory_t))

/*
 * Types
 */
typedef struct memory	memory_t;
struct memory {
    memory_t		*next;
#if __WORDSIZE == 64
    eint32_t		 align;
#endif
    eint32_t		 header;
};

/*
 * Prototypes
 */
static void
new_object(eobject_t *pointer, etype_t type, eword_t length);

static void
gc(void);

static void
gc_mark_record(eint8_t *base, eword_t *gcinfo, eword_t gcsize);

static void
gc_mark(memory_t *memory);

static void
gc_mark_roots(void);

/*
 * Initialization
 */
ethread_t		 *thread_main;
evector_t		 *rtti_vector;
evector_t		 *rtdi_vector;
eint32_t		  gc_offset;
eobject_t		  gc_vector[16];
#if GC_DEBUG
eint32_t		  gc_debug = 1;
#endif

static memory_t		 *gc_root;
static memory_t		 *gc_tail;
static eobject_t	**gc_root_vector;
static eword_t		  gc_root_offset;
static eword_t		  gc_root_length;
#if !GC_DEBUG
static eword_t		  gc_bytes;
#endif

#if CACHE_DEBUG
eint32_t		  cache_debug = 1;
static eobject_t	  cache_object;
#endif

/*
 * Implementation
 */
void
init_object(void)
{
    new_object((eobject_t *)&thread_main, t_thread, sizeof(ethread_t));
    cqq_init(&thread_main->qq);
    mpc_init2(&thread_main->cc, thr_prc);
    enew_vector((eobject_t *)&thread_main->vec, t_uint8, BUFSIZ);

    enew_vector((eobject_t *)&rtti_vector, t_void, 128);
    enew_vector((eobject_t *)&rtdi_vector, t_void, 8);

    thread_self = thread_main;
#if HAVE_THREAD
    thread_main->pthread = pthread_self();
#endif
}

void
finish_object(void)
{
    gc_root_offset = 0;
    gc_offset = 0;
    rtti_vector = null;
    rtdi_vector = null;
    cqq_clear(&thread_main->qq);
    mpc_clear(&thread_main->cc);
    thread_main = null;

    /*   All memory should be released. */
#if CACHE_DEBUG
    cache_object = null;
    /* ewarn should not work anyway because streams are closed */
    cache_debug = 0;
#endif

    /*   finish_stream() must be called just before finish_object() */
    std_input = std_output = std_error = null;
    gc();

    assert(gc_root == null);
}

void
eadd_root(eobject_t *object)
{
    if (gc_root_offset >= gc_root_length) {
	if ((gc_root_length += 16) == 16) {
	    if ((gc_root_vector = malloc(sizeof(eobject_t) * 16)) == null)
		eerror("out of memory");
	}
	else if ((gc_root_vector = realloc(gc_root_vector, sizeof(eobject_t) *
					   gc_root_length)) == null)
	    eerror("out of memory");
    }
    assert(object);
    gc_root_vector[gc_root_offset++] = object;
}

void
erem_root(eobject_t *object)
{
    eword_t		offset;

    for (offset = gc_root_offset - 1; offset >= 0; offset--) {
	if (gc_root_vector[offset] == object) {
	    if (--gc_root_offset)
		gc_root_vector[offset] = gc_root_vector[gc_root_offset];
	    return;
	}
    }
    /*  Streams may no longer be available. */
    abort();
}

void
enew_object(eobject_t *pointer, etype_t type, eword_t length)
{
    /*  Run gc roughly every 16 megabytes. */
#if GC_DEBUG
    if (gc_debug)
	gc();
#else
    if (gc_bytes > (1 << 24)) {
	gc();
	gc_bytes = 0;
    }
    gc_bytes += length;
#endif

    new_object(pointer, type, length);
}

void
enew_word(eobject_t *pointer, eword_t w)
{
    enew_object(pointer, t_word, sizeof(eword_t));
    **(eword_t **)pointer = w;
}

void
enew_float(eobject_t *pointer, efloat_t d)
{
    enew_object(pointer, t_float, sizeof(efloat_t));
    **(efloat_t **)pointer = d;
}

void
enew_float_w(eobject_t *pointer, eword_t w)
{
    enew_object(pointer, t_float, sizeof(efloat_t));
    **(efloat_t **)pointer = w;
}

void
enew_rat(eobject_t *pointer, erat_t R)
{
    erat_t		r;

    enew_object(pointer, t_rat, sizeof(rat_t));
    r = *(erat_t *)pointer;
    erat_num(r) = erat_num(R);
    erat_den(r) = erat_den(R);
}

void
enew_rat_w(eobject_t *pointer, eword_t w)
{
    erat_t		r;

    enew_object(pointer, t_rat, sizeof(rat_t));
    r = *(erat_t *)pointer;
    erat_num(r) = w;
    erat_den(r) = 1;
}

void
enew_mpz(eobject_t *pointer, empz_t Z)
{
    empz_t		z;

    enew_object(pointer, t_mpz, sizeof(mpz_t));
    z = *(empz_t *)pointer;
    mpz_init_set(z, Z);
}

void
enew_mpz_w(eobject_t *pointer, eword_t w)
{
    empz_t		z;

    enew_object(pointer, t_mpz, sizeof(mpz_t));
    z = *(empz_t *)pointer;
    mpz_init_set_si(z, w);
}

void
enew_mpq(eobject_t *pointer, empq_t Q)
{
    empq_t		q;

    enew_object(pointer, t_mpq, sizeof(mpq_t));
    q = *(empq_t *)pointer;
    mpq_init(q);
    mpq_set(q, Q);
}

void
enew_mpq_w(eobject_t *pointer, eword_t w)
{
    empq_t		q;

    enew_object(pointer, t_mpq, sizeof(mpq_t));
    q = *(empq_t *)pointer;
    mpq_init(q);
    mpq_set_si(q, w, 1);
}

void
enew_mpr(eobject_t *pointer, empr_t R)
{
    empr_t		r;

    enew_object(pointer, t_mpr, sizeof(mpfr_t));
    r = *(empr_t *)pointer;
    mpfr_init2(r, thr_prc);
    mpfr_set(r, R, thr_rnd);
}

void
enew_mpr_w(eobject_t *pointer, eword_t w)
{
    empr_t		r;

    enew_object(pointer, t_mpr, sizeof(mpfr_t));
    r = *(empr_t *)pointer;
    mpfr_init2(r, thr_prc);
    mpfr_set_si(r, w, thr_rnd);
}

void
enew_cdd(eobject_t *pointer, ecdd_t DD)
{
    ecdd_t		*dd;

    enew_object(pointer, t_cdd, sizeof(ecdd_t));
    dd = *(ecdd_t **)pointer;
    *dd = DD;
}

void
enew_cdd_w(eobject_t *pointer, eword_t w)
{
    ecdd_t		*c;

    enew_object(pointer, t_cdd, sizeof(ecdd_t));
    c = *(ecdd_t **)pointer;
    real(*c) = w;
}

void
enew_cqq(eobject_t *pointer, ecqq_t QQ)
{
    ecqq_t	qq;

    enew_object(pointer, t_cqq, sizeof(cqq_t));
    qq = *(ecqq_t *)pointer;
    cqq_init(qq);
    cqq_set(qq, QQ);
}

void
enew_cqq_w(eobject_t *pointer, eword_t w)
{
    ecqq_t	qq;

    enew_object(pointer, t_cqq, sizeof(cqq_t));
    qq = *(ecqq_t *)pointer;
    cqq_init(qq);
    mpz_set_si(mpq_numref(cqq_realref(qq)), w);
}

void
enew_mpc(eobject_t *pointer, empc_t CC)
{
    empc_t		cc;

    enew_object(pointer, t_mpc, sizeof(mpc_t));
    cc = *(empc_t *)pointer;
    mpc_init2(cc, thr_prc);
    mpc_set(cc, CC, thr_rnd);
}

void
enew_mpc_w(eobject_t *pointer, eword_t w)
{
    empc_t		cc;

    enew_object(pointer, t_mpc, sizeof(mpc_t));
    cc = *(empc_t *)pointer;
    mpc_init2(cc, thr_prc);
    mpfr_set_si(mpc_realref(cc), w, thr_rnd);
    mpfr_set_ui(mpc_imagref(cc), 0, thr_rnd);
}

void
enew_vector_base(eobject_t *pointer,
		 etype_t type, etype_t base_type,
		 eword_t length, eword_t base_length)
{
    eword_t		 bytes;
    evector_t		*vector;

    enew_object((eobject_t *)pointer, base_type, base_length);
    vector = *pointer;
    vector->length = length;
    switch (type) {
	case t_int8:	case t_uint8:
	    bytes = length;
	    break;
	case t_int16:	case t_uint16:
	    bytes = length << 1;
	    break;
	case t_int32:	case t_uint32:	case t_float32:
#if __WORDSIZE == 32
	default:
#endif
	    bytes = length << 2;
	    break;
	case t_int64:	case t_uint64:	case t_float64:
#if __WORDSIZE == 64
	default:
#endif
	    bytes = length << 3;
	    break;
    }

    bytes = (bytes + 15) & ~15;
    if (bytes < length)
	eerror("out of bounds");
    new_object(&vector->v.obj, type, bytes);
}

void
erenew_vector(evector_t *vector, eword_t length)
{
    memory_t		*memory;
    eword_t		 new_bytes;
    eword_t		 old_bytes;
    eword_t		 new_length;
    eword_t		 old_length;
    memory_t		*new_memory;
    memory_t		*old_memory;

    old_memory = object_to_memory(vector->v.obj);
    switch (old_memory->header) {
	case t_int8:	case t_uint8:
	    new_length = length;
	    old_length = vector->length;
	    break;
	case t_int16:	case t_uint16:
	    new_length = length << 1;
	    old_length = vector->length << 1;
	    break;
	case t_int32:	case t_uint32:	case t_float32:
#if __WORDSIZE == 32
	default:
#endif
	    new_length = length << 2;
	    old_length = vector->length << 2;
	    break;
	case t_int64:	case t_uint64:	case t_float64:
#if __WORDSIZE == 64
	default:
#endif
	    new_length = length << 3;
	    old_length = vector->length << 3;
	    break;
    }

    new_bytes = ((new_length + 15) & ~15) + sizeof(memory_t);
    old_bytes = ((old_length + 15) & ~15) + sizeof(memory_t);

    if (unlikely(new_bytes < new_length))
	eerror("out of bounds");
    vector->length = length;

    if (new_bytes != old_bytes) {
	memory = object_to_memory(vector);
	assert(memory->next == old_memory);
	if (unlikely((new_memory = realloc(old_memory, new_bytes)) == null))
	    eerror("out of memory");
	if (old_memory != new_memory) {
	    if (gc_tail == old_memory)
		gc_tail = new_memory;
	    memory->next = new_memory;
	    vector->v.obj = memory_to_object(eobject_t, new_memory);
	}

	/*   Must to zero out increased vector before possible gc call. */
	if (new_length > old_length)
	    memset(vector->v.u8 + old_length, 0, new_length - old_length);
#if GC_DEBUG
	if (gc_debug)
	    gc();
#else
	gc_bytes += new_length - old_length;
	/*  Run gc roughly every 16 megabytes. */
	if (gc_bytes > (1 << 24)) {
	    gc();
	    gc_bytes = 0;
	}
#endif
    }
    else if (new_length > old_length)
	memset(vector->v.u8 + old_length, 0, new_length - old_length);
}

static void
new_object(eobject_t *pointer, etype_t type, eword_t length)
{
    eword_t		 bytes;
    eobject_t		 object;
    memory_t		*memory;

    if ((bytes = length + sizeof(memory_t)) < length)
	eerror("invalid object length");

    if ((memory = (memory_t *)calloc(1, bytes)) == null)
	eerror("out of memory");
    object = memory_to_object(eobject_t, memory);
    if (unlikely(gc_root == null))
	gc_root = gc_tail = memory;
    else
	gc_tail->next = memory;
    gc_tail = memory;
    memory->header = type;
    *pointer = object;
}

#if CACHE_DEBUG
void
gc_cache_debug(eobject_t object)
{
    cache_object = object;
    gc();
}
#endif

static void
gc(void)
{
    memory_t		*prev;
    memory_t		*next;
    memory_t		*memory;
#if CACHE_DEBUG
    eint32_t		 cache_count = 0;
#endif

    gc_mark_roots();

    prev = next = gc_root;
    while ((memory = next)) {
	if (mark_p(memory)) {
	    clear(memory);
	    prev = memory;
	    next = memory->next;
#if CACHE_DEBUG
	    switch (memory->header) {
		case t_word:	case t_float:	case t_rat:
		case t_mpz:	case t_mpq:	case t_mpr:
		case t_cdd:	case t_cqq:	case t_mpc:
		case t_ast:
		    if (memory_to_object(eobject_t, memory) == cache_object) {
			++cache_count;
			assert(cache_count == 1);
		    }
		    break;
	    }
#endif
	}
	else {
	    next = memory->next;
	    /* release extra memory or free system resources */
	    switch (memory->header) {
		case t_stream:
		    eclose(memory_to_object(estream_t *, memory));
		    break;
		case t_mpz:
		    mpz_clear(memory_to_object(empz_t, memory));
#if CACHE_DEBUG
		    if (cache_debug)
			ewarn("cache leak");
#endif
		    break;
		case t_mpq:
		    mpq_clear(memory_to_object(empq_t, memory));
#if CACHE_DEBUG
		    if (cache_debug)
			ewarn("cache leak");
#endif
		    break;
		case t_mpr:
		    mpfr_clear(memory_to_object(empr_t, memory));
#if CACHE_DEBUG
		    if (cache_debug)
			ewarn("cache leak");
#endif
 		    break;
		case t_cqq:
		    cqq_clear(memory_to_object(ecqq_t, memory));
#if CACHE_DEBUG
		    if (cache_debug)
			ewarn("cache leak");
#endif
		    break;
		case t_mpc:
		    mpc_clear(memory_to_object(empc_t, memory));
#if CACHE_DEBUG
		    if (cache_debug)
			ewarn("cache leak");
#endif
		    break;
#if CACHE_DEBUG
		case t_word:	case t_float:	case t_rat:
		case t_ast:
		    if (cache_debug)
			ewarn("cache leak");
		    break;
#endif
	    }
	    if (unlikely(gc_root == memory))
		gc_root = next;
	    else
		prev->next = next;
	    free(memory);
	}
    }
    /*  Bogus if gc_root becomes null, but not used in that case. */
    gc_tail = prev;

#if CACHE_DEBUG
    if (cache_object)
	assert(cache_count == 1);
#endif
}

static void
gc_mark_record(eint8_t *base, eword_t *gcinfo, eword_t gcsize)
{
    eword_t		 offset;
    eobject_t		 object;
    eobject_t		*pointer;

    for (offset = 0; offset < gcsize; offset++) {
	pointer = (eobject_t *)(base + gcinfo[offset]);
	if ((object = *pointer))
	    gc_mark(object_to_memory(object));
    }
}

static void
gc_mark(memory_t *memory)
{
    eint8_t		*base;
    ertti_t		*rtti;
    etype_t		 type;
    eentry_t		*entry;
    eword_t		 offset;
    eobject_t		*pointer;
    union {
	east_t		*ast;
	eentry_t	*entry;
	efunction_t	*function;
	ehash_t		*hash;
	einput_t	*input;
	enamespace_t	*namespace;
	eobject_t	 object;
	eobject_t	*pointer;
	erecord_t	*record;
	ertti_t		*rtti;
	estream_t	*stream;
	esymbol_t	*symbol;
	evalue_t	*value;
	evector_t	*vector;
    } o;

again:
    if (mark_p(memory))
	return;
    mark(memory);
    o.object = memory_to_object(eobject_t, memory);
    switch (type = memory->header) {
	case t_ast:
	    if (o.ast->l.value)
		gc_mark(object_to_memory(o.ast->l.value));
	    if (o.ast->r.value)
		gc_mark(object_to_memory(o.ast->r.value));
	    if (o.ast->t.value)
		gc_mark(object_to_memory(o.ast->t.value));
	    if (o.ast->c.value)
		gc_mark(object_to_memory(o.ast->c.value));
	    if (o.ast->next) {
		memory = object_to_memory(o.ast->next);
		goto again;
	    }
	    break;
	case t_entry:				case t_tag:
	    if (o.entry->value) {
		if (o.entry->name)
		    gc_mark(object_to_memory(o.entry->name));
		memory = object_to_memory(o.entry->value);
		goto again;
	    }
	    else if (o.entry->name) {
		memory = object_to_memory(o.entry->name);
		goto again;
	    }
	    break;
	case t_function:
	    if (o.function->tag)
		gc_mark(object_to_memory(o.function->tag));
	    if (o.function->ast)
		gc_mark(object_to_memory(o.function->ast));
	    if (o.function->namespace)
		gc_mark(object_to_memory(o.function->namespace));
	    if (o.function->label_table)
		gc_mark(object_to_memory(o.function->label_table));
	    if (o.function->alias_table)
		gc_mark(object_to_memory(o.function->alias_table));
	    if (o.function->value_vector)
		gc_mark(object_to_memory(o.function->value_vector));
	    if (o.function->value) {
		memory = object_to_memory(o.function->value);
		goto again;
	    }
	    break;
	case t_hash:
	    if (o.hash->entries) {
		mark(object_to_memory(o.hash->entries));
		if (o.hash->count) {
		    for (offset = 0; offset < o.hash->size; offset++) {
			entry = o.hash->entries[offset];
			for (; entry; entry = entry->next)
			    gc_mark(object_to_memory(entry));
		    }
		}
	    }
	    break;
	case t_input:
	    if (o.input->stream) {
		memory = object_to_memory(o.input->stream);
		goto again;
	    }
	    break;
	case t_class:				case t_namespace:
	    if (o.namespace->parent)
		gc_mark(object_to_memory(o.namespace->parent));
	    if (o.record->gcinfo)
		gc_mark(object_to_memory(o.record->gcinfo));
	    if (o.record->vector)
		gc_mark(object_to_memory(o.record->vector));
	    if (o.record->fields) {
		memory = object_to_memory(o.record->fields);
		goto again;
	    }
	    break;
	case t_value:
	    if (o.value->name)
		gc_mark(object_to_memory(o.value->name));
	    if (o.value->alias)
		gc_mark(object_to_memory(o.value->alias));
	    if (o.value->hash) {
		memory = object_to_memory(o.value->hash);
		goto again;
	    }
	    break;
	case t_rtti:
	    if (o.rtti->gcinfo)
		mark(object_to_memory(o.rtti->gcinfo));
	    break;
	case t_symbol:
	    if (o.symbol->value) {
		memory = object_to_memory(o.symbol->value);
		goto again;
	    }
	    break;
	case t_stream:
	    if (o.stream->ptr) {
		if (o.stream->name)
		    gc_mark(object_to_memory(o.stream->name));
		memory = object_to_memory(o.stream->ptr);
		goto again;
	    }
	    else if (o.stream->name) {
		memory = object_to_memory(o.stream->name);
		goto again;
	    }
	    break;
	case t_vector_int8:			case t_vector_uint8:
	case t_vector_int16:			case t_vector_uint16:
	case t_vector_int32:			case t_vector_uint32:
	case t_vector_int64:			case t_vector_uint64:
	case t_vector_float32:			case t_vector_float64:
	    if ((o.object = o.vector->v.obj))
		mark(object_to_memory(o.object));
	    break;
	default:
	    if (type & t_vector) {
		if ((pointer = o.vector->v.ptr + o.vector->length)) {
		    o.object = o.vector->v.obj;
		    memory = object_to_memory(o.object);
		    mark(memory);
		    for (--pointer; o.pointer < pointer; o.pointer++) {
			if (*o.pointer)
			    gc_mark(object_to_memory(*o.pointer));
		    }
		    if ((o.object = *o.pointer)) {
			memory = object_to_memory(o.object);
			goto again;
		    }
		}
	    }
	    else if (type > t_void && type < rtti_vector->offset) {
		rtti = rtti_vector->v.ptr[type];
		base = memory_to_object(eint8_t *, memory);
		gc_mark_record(base, rtti->gcinfo, rtti->gcsize);
	    }
	    break;
    }
}

static void
gc_mark_roots(void)
{
    eword_t		 offset;
    eobject_t		 object;

    for (offset = 0; offset < gc_root_offset; offset++) {
	if ((object = *gc_root_vector[offset]))
	    gc_mark(object_to_memory(object));
    }
    for (offset = 0; offset < gc_offset; offset++) {
	if ((object = gc_vector[offset]))
	    gc_mark(object_to_memory(object));
    }

    if (rtti_vector)
	gc_mark(object_to_memory(rtti_vector));
    if (rtdi_vector)
	gc_mark(object_to_memory(rtti_vector));

    if (thread_main) {
	mark(object_to_memory(thread_main));
	if (thread_main->vec)
	    gc_mark(object_to_memory(thread_main->vec));
    }
}
